      SUBROUTINE SLNPDM(A,B,etol,d,IT,itri,N,nc2m)
C
C Solucao do sistema linear de equacoes pelo metodo de eliminacao de
C GAUSS, tendo a opcao de resolver sistemas ja triangularizados
C quando (ITRI.NE.0).
C
C
C A: Matriz do sistema.
C B: Matriz dos termos independentes.
C   Obs.: Originalmente B contem os coeficientes independentes e depois
C         de resolvido ela contem os valores das incognitas do sistema.
C IT: Vetor que acumula as linhas trocadas. E usado na resolucao de
C     sistemas ja triangularizados
C
C N: Numero atual de incognitas.
C


      IMPLICIT DOUBLE PRECISION (A-H,O-Z)

      DIMENSION A(N,N),B(N,NC2m),IT(N)


!         do j=1,nc2m
!             r=0.
!             do i=1,N
!                     r = r + b(i,j)**2
!             enddo
!         
!             write(*,*)j,'Antes solve slnpdm |b| = ',r
!         enddo

      N1=N-1

!       IF (ITRI.EQ.0) THEN
!          NC2M= 1
!       ELSE
!          NC2M= 2*NNP
!       END IF

      DO 10 K=1,N1
         K1=K+1
         C=A(K,K)
         IF (ITRI.EQ.0) THEN
            IT(K)= 0
         END IF
         IF(ABS(C).LE.etol) THEN
           DO 20 J= K1,N
C
C TENTA TROCAR LINHAS PARA OBTER COEFICIENTES DA DIAGONAL NAO NULOS.
C
              IF(ABS(A(J,K)).GT.etol) THEN
                 IT(K)= J
                 DO 30 L=K,N
                    C= A(K,L)
                    A(K,L)= A(J,L)
                    A(J,L)= C
 30              CONTINUE

                 DO 40 L=1,NC2M
                    C= B(K,L)
                    B(K,L)= B(J,L)
                    B(J,L)= C
 40              CONTINUE

                 C= A(K,K)
              ELSE

                 IF(K1.EQ.N) THEN
                   !  write(*,1001) K
 1001              FORMAT('**** SINGULARIDADE NA LINHA',I5)
                   stop
                   D= 0.
                   GO TO 999
                 END IF
              END IF
 20        CONTINUE
         END IF

C
C DIVIDE A LINHA PELO COEFICIENTE DA DIAGONAL
C
         IF (ITRI.EQ.0) THEN
            DO 50 J=K1,N
               A(K,J)=A(K,J)/C
 50         CONTINUE
         ELSE IF (IT(K).NE.0) THEN
            DO 60 J=1,NC2M
               CH= B(K,J)
               B(K,J)= B(IT(K),J)
               B(IT(K),J)= CH
 60         CONTINUE
         END IF

         DO 70 J=1,NC2M
            B(K,J)=B(K,J)/C
 70      CONTINUE

C
C ELIMINACAO DAS INCOGNITAS X(I) DA COLUNA K
C
         DO 80 I=K1,N
            C=A(I,K)
            IF (ITRI.EQ.0) THEN
               DO 90 J=K1,N
                  A(I,J)=A(I,J)-C*A(K,J)
 90            CONTINUE
            END IF

            DO 100 J=1,NC2M
               B(I,J)=B(I,J)-C*B(K,J)
 100        CONTINUE
 80      CONTINUE

 10   CONTINUE

C
C CALCULO DA ULTIMA INCOGNITA
C
      IF(ABS(A(N,N)).LT.etol) THEN
        !  write(*,1001)K
        D= 0.
        GOTO 999
      END IF

      DO 110 J=1,NC2M
         B(N,J)=B(N,J)/A(N,N)
 110  CONTINUE

C
C APLICACAO DO METODO DE RETROSUBSTITUICAO PARA CALCULO DAS INCOGNITAS
C RESTANTES
C
      DO 120 L=1,N1
         K=N-L
         K1=K+1
         DO 130 JJ=1,NC2M
            DO 140 J=K1,N
               B(K,JJ)=B(K,JJ)-A(K,J)*B(J,JJ)
 140        CONTINUE
 130     CONTINUE
 120  CONTINUE

C
C CALCULO DO VALOR DO DETERMINANTE
C
      D=1.
      DO 150 I=1,N
         D=D*A(I,I)
 150  CONTINUE

c      !  write(*,*) 'Determinante em SLNPDM',d

!         do j=1,nc2m
!             r=0.
!             do i=1,N
!                     r = r + b(i,j)**2
!             enddo
!         
!             write(*,*)j,'Apos solve slnpdm |b| = ',r
!         enddo


 999  RETURN
      END

